home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff1.arc / JDATE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-01-31  |  4.8 KB  |  111 lines
  1.  
  2. { Julian number to date conversions -  9/10/1984
  3.     Actually, these are not Julian dates but rather just day numbers designed for use with dates in the
  4.   twentieth century. The dates are stored in a standard integer variable and range from January 1,1900 as
  5.   -32767 to sometime in the twenty-first century at +32767.  The advantage of using day numbers is that the
  6.   number of days between two dates is simply calculated as Date1-Date2.
  7.     A magic number to be remembered is the one used to convert from the dates in this format into the dates
  8.   used by Digital Research in products such as CP/M Plus.  To convert into DRI's format from mine, add 4279
  9.   to the integer value.  To convert back from DRI's format into mine, subtract 4279.
  10.     The algorithms used in these routines were taken from an article in Dr Dobb's Journal and came from
  11.   an ACM publication before that.  If an exact bibliography is desired, contact me on Compuserve [74206,21].
  12.   I am releasing any and all rights that I may have on these routines into the public domain and only hope
  13.   that any fixes or enhancements are re-released to the public.
  14.       Scott Bussinger
  15.       Professional Practice Systems
  16.       112 South 131st Street
  17.       Tacoma, Wa 98444 }
  18.  
  19. procedure DtoJ(Day,Month,Year: integer;var Julian: integer);
  20.   { Convert from a date to a Julian number -- January 1, 1900 = -32767 }
  21.   { Note that much care is taken to avoid problems with inaccurate bit representations inherent in the binary fractions
  22.     of the real numbers used as temporary variables.  Thus the seemingly unnecessary use of small fractional offsets
  23.     and int() functions }
  24.   begin
  25.   if (Year=1900) and (Month<3)                   { Handle the first two months as a special case since the general }
  26.    then                                          {   algorithm used doesn't start until March 1, 1900 }
  27.     if Month=1
  28.      then
  29.       Julian := Day-$8000                        { Compiler won't accept -32768 as a valid integer, so use the hex form }
  30.      else
  31.       Julian := Day-32737
  32.    else
  33.     begin
  34.     if Month>2
  35.      then
  36.       Month := Month-3
  37.      else
  38.       begin
  39.       Month := Month+9;
  40.       Year := Year-1
  41.       end;
  42.     Year := Year-1900;
  43.     Julian := round(-32709.0+Day+int(0.125+int(1461.0*Year+0.5)/4.0))+((153*Month+2) div 5)
  44.     end
  45.   end;
  46.  
  47. procedure JtoD(Julian: integer;var Day,Month,Year: integer);
  48.   { Convert from a Julian date to a calendar date }
  49.   { Note that much care is taken to avoid problems with inaccurate bit representations inherent in the binary fractions
  50.     of the real numbers used as temporary variables.  Thus the seemingly unnecessary use of small fractional offsets
  51.     and int() functions }
  52.   var Temp: real;
  53.   begin
  54.   Temp := int(32767.5+Julian);                   { Convert 16 bit quantity into a real number }
  55.   if Temp<58.5
  56.    then
  57.     begin                                        { The first two months of the twentieth century are handled as a special }
  58.     Year := 1900;                                {   case of the general algorithm used which handles all of the rest }
  59.     if Temp<30.5
  60.      then
  61.       begin
  62.       Month := 1;
  63.       Day := round(Temp+1.0)
  64.       end
  65.      else
  66.       begin
  67.       Month := 2;
  68.       Day := round(Temp-30.0)
  69.       end
  70.     end
  71.    else
  72.     begin
  73.     Temp := int(4.0*(Temp-59.0)+3.5);
  74.     Year := trunc(Temp/1461.0+0.00034223);     { 0.00034223 is about one half of the reciprocal of 1461.0 }
  75.     Day := succ(round(Temp-Year*1461.0) div 4);
  76.     Month := (5*Day-3) div 153;
  77.     Day := succ((5*Day-3) mod 153 div 5);
  78.     Year := Year+1900;
  79.     if Month<10
  80.      then
  81.       Month := Month+3
  82.      else
  83.       begin
  84.       Month := Month-9;
  85.       Year := succ(Year)
  86.       end
  87.     end
  88.   end;
  89.  
  90. function DayOfWeek(Julian: integer): integer;
  91.   { Return an integer representing the day of week for the date }
  92.   { Sunday = 0, etc. }
  93.   var Temp: real;
  94.   begin
  95.   Temp := Julian+32767.0;                        { Convert into a real temporary variable }
  96.   DayOfWeek := round(frac((Temp+1.0)/7.0)*7.0)   { Essentially this is a real number version of Julian mod 7 with }
  97.   end;                                           { an offset to make Sunday = 0 }
  98.  
  99. procedure WriteDate(Julian: integer);
  100.   { Write the date out to the console in long form , e.g. "Monday, September 10, 1984" }
  101.   const Days: array[0..6] of string[9]=('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
  102.         Months: array[1..12] of string[9] = ('January','February','March','April','May','June',
  103.                                              'July','August','September','October','November','December');
  104.   var Day,Month,Year: integer;
  105.   begin
  106.   JtoD(Julian,Day,Month,Year);                   { Convert into date form }
  107.   write(Days[DayOfWeek(Julian)],', ',Months[Month],' ',Day,', ',Year);
  108.   end;
  109.  
  110.  
  111.